;;;; RLlib copyright 2010 Adam White (theroguemonkey@gmail.com)
;;;; Licensed under GNU General Public Licence v2 or later - refer COPYING

(in-package #:rllib)

;;;============================================================================
;;; Item
;;;============================================================================

(defclass item ()
  ((class 
    :initarg :class 
    :reader item-class
    :initform (error "Class of item must be declared"))
   (sub-type
    :initarg :subtype 
    :reader item-subtype)
   (number 
    :initarg :number 
    :accessor item-number 
    :initform 1)
   (properties 
    :initarg :properties 
    :accessor item-properties 
    :initform nil)))

(defgeneric random-item (class)
  (:documentation "Make an item of class CLASS"))

(defgeneric item-stacks (item)
  (:documentation "Can this particular ITEM stack?")
  (:method ((item item)) nil))

(defmethod output-symbol ((item item))
  (item-subtype item))

(defmethod item-alpha ((item item) &optional last-alpha)
  (getf (item-properties item)
	:alpha
	(case last-alpha
	  ((nil #\Z) #\a)
	  ((#\z) #\A)
	  (t (code-char (1+ (char-code last-alpha)))))))

(defmethod gender ((item item))
  :neuter)


;;;============================================================================
;;; Item Piles
;;;============================================================================

(defun filter-items (items criteria)
  (remove-if-not (call-every-pred criteria) items))

(defun same-item-filters (item)
  (let ((class (item-class item))
	(subtype (item-subtype item)))
      (list #'(lambda (c)
	    (eql class (item-class c)))
	#'(lambda (c)
	    (eql subtype (item-subtype c))))))


(defun add-item (item pile)
  (bif duplicate (and (item-stacks item)
		      (filter-items pile (same-item-filters item)))
       (progn (incf (item-number (car duplicate)) (item-number item)) pile)
       (cons item pile)))

(defun delete-item (item pile)
  (let ((dup (and (item-stacks item)
		  (apply #'filter-items pile (same-item-filters item)))))
    (if (and dup (< (item-number item) (item-number (car dup))))
	(progn (decf (item-number (car dup)) (item-number item)) pile)
	(delete-if (call-every-pred (same-item-filters item)) pile))))

